home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
LIBRARY
/
PASCALL
/
VIDEO
/
FERNANDO.PAS
next >
Wrap
Pascal/Delphi Source File
|
1993-02-26
|
4KB
|
142 lines
{****************************************************************************}
{*********************** ***********************}
{** R-G-B Demonstrator **}
{**************************** ****************************}
{** Copyrighted February 12, 1993 **}
{** (C) To Authors **}
{** Fernando Padilla **}
{****************************** ******************************}
{****************************************************************************}
unit Fernando;
interface
uses
Roger;
const
blendframes:byte=100;
gfull=63;
ggone=15;
gnone=0;
rfull=100;
rgone=24;
rnone=0;
type
pRGB=(
R,
RRRG,
RRG,
RRRGG,
RG,
RRGGG,
RGG,
RGGG,
G,
GGGB,
GGB,
GGGBB,
GB,
GGBBB,
GBB,
GBBB,
B,
BBBR,
BBR,
BBBRR,
BR,
BBRRR,
BRR,
BRRR,
W
);
cRGB=record
color,
red,
green,
blue:byte;
end;
function rat(percent:byte):integer;
function ginverse(a:integer):integer;
function rinverse(a:integer):integer;
procedure setcolr(a,b,c,d:integer);
procedure setrevcolr(a,b,c,d:integer);
procedure park(a,b,c,d:integer; var p:crgb);
procedure getcolr(c:prgb; var p:crgb; i:integer);
function increment(n1,n2,p:integer):integer;
procedure incrementer(p1,p2:crgb; a:byte; var p3:crgb);
implementation
function rat(percent:byte):integer;
begin rat:=trunc(gfull*(percent/rfull)); end;
function ginverse(a:integer):integer;
begin ginverse:=abs(a-gfull); end;
function rinverse(a:integer):integer;
begin rinverse:=abs(a-rfull); end;
procedure setcolr(a,b,c,d:integer);
begin putcolor(a,rat(b),rat(c),rat(d)); end;
procedure setrevcolr(a,b,c,d:integer);
begin PutColor(a,rat(rinverse(b)),rat(rinverse(c)),rat(rinverse(d))); end;
procedure park(a,b,c,d:integer; var p:crgb);
begin
with p do begin
color:=a;
red:=b;
green:=c;
blue:=d;
end;
end;
procedure getcolr(c:prgb; var p:crgb; i:integer);
begin
Case c of
R: park(0,i,0,0,p);
RRRG: park(0,i,i div 3,0,p);
RRG: park(0,i,i div 2,0,p);
RRRGG: park(0,i,(i*2) div 3,0,p);
RG: park(0,i,i,0,p);
RRGGG: park(0,(i*2) div 3,i,0,p);
RGG: park(0,i div 2,i,0,p);
RGGG: park(0,i div 3,i,0,p);
G: park(0,0,i,0,p);
GGGB: park(0,0,i,i div 3,p);
GGB: park(0,0,i,i div 2,p);
GGGBB: park(0,0,i,(i*2) div 3,p);
GB: park(0,0,i,i,p);
GGBBB: park(0,0,(i*2) div 3,i,p);
GBB: park(0,0,i div 2,i,p);
GBBB: park(0,0,i div 3,i,p);
B: park(0,0,0,i,p);
BBBR: park(0,i div 3,0,i,p);
BBR: park(0,i div 2,0,i,p);
BBBRR: park(0,(i*2) div 3,0,i,p);
BR: park(0,i,0,i,p);
BBRRR: park(0,i,0,(i*2) div 3,p);
BRR: park(0,i,0,i div 2,p);
BRRR: park(0,i,0,i div 3,p);
W: park(0,i,i,i,p);
end;
end;
function increment(n1,n2,p:integer):integer;
begin increment:=trunc(((n2-n1)*(p/blendframes))+n1); end;
procedure incrementer(p1,p2:crgb; a:byte; var p3:crgb);
begin
if p1.color=p2.color then
with p3 do begin
color:=p1.color;
red:=increment(p1.red,p2.red,a);
green:=increment(p1.green,p2.green,a);
blue:=increment(p1.blue,p2.blue,a);
end;
end;
begin
end.